home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / autorefile.tcl.z / autorefile.tcl
Text File  |  2002-07-08  |  4KB  |  99 lines
  1. # autorefile.tcl
  2. #This is the 'auto-refile' feature; this emulates the mh-utility that
  3. #I've used for years, which takes an existing message, and figures out an
  4. #appropriate folder to file it in, i.e., a message with an address of
  5. #host1!host2!someluser%host3@host4 should go in the folder +someluser .
  6. #To avoid the problems associated with the foldername generated by an address
  7. #of some-insipid-corporate-mailing-alias@big.corp.com, I personally use a
  8. #'zoo' subdirectory, and ~/Mail/zoo/some-insipid-corporate-mailing-alias
  9. #will be (soft) linked to something like ~/Mail/charlie; my auto-refile places
  10. #the message in +zoo/some-insipid-corporate-mailing-alias, but I can still get
  11. #to it via +charlie -- anyway, that's why the code below checks for a folder
  12. #under ~/Mail/zoo as well as under ~/Mail; if you really wanted to use this,
  13. #I suppose I should expand it so that it actually searches all subfolders rather
  14. #than just 'zoo'.
  15.  
  16. # Credit: John Carroll <carroll@cs.sdsu.edu>
  17.  
  18. proc FolderAutoFind {pattern} {
  19.     global exwin
  20.  
  21.     scan [$exwin(mtext) index end] %d numLines
  22.     for {set i 1} {$i < $numLines} {incr i} {
  23.     $exwin(mtext) mark set last $i.0
  24.     if {[regexp -indices $pattern \
  25.         [$exwin(mtext) get last "last lineend"] indices]} {
  26.         $exwin(mtext) mark set first "last + [lindex $indices 0] chars"
  27.         $exwin(mtext) mark set last "last + 1 chars + [lindex $indices 1] chars"
  28.         return [$exwin(mtext) get [$exwin(mtext) index first] \
  29.             [$exwin(mtext) index "first lineend"]]
  30.     }
  31.     }
  32. }
  33.  
  34. proc FolderAutoParse {adrline} {
  35.     # extract a username from a 'Return-path', 'From', or 'To' line.
  36.     # the following also handles 'some cruft <real.address> more cruft'
  37.     # turn 'From: a!B!C%d@e (some name)' into just 'a!b!c%d@e (some name)' :
  38.     regsub -nocase {^(From|Return-Path|To|Cc|List-id):[     ]*} \
  39.     [string tolower $adrline] {} adrline0
  40.     # turn 'a!b!c%d@e' (some name) into just 'a!b!c%d@e' :
  41.     regsub -all "\\(.*\\)" $adrline0 {} adrline1
  42.     # turn 'a!b!c%d@e' into just 'a!b!c' :
  43.     regsub -all "\[%@>\].*" $adrline1 {} adrline2
  44.     # turn 'a!b!c' into just 'c' :
  45.     regsub -all ".*\[<!\]" $adrline2 {} adrline3
  46.     # a 'To:' address might still be 'name1, name2, name3'; resolve to 'name1' :
  47.     regsub -all {[/ ,].*} $adrline3 {} target
  48.     return $target
  49. }
  50.  
  51. proc Folder_AutoRefile {} {
  52.     global env msg
  53.     # find a header line with a username (that isn't our own username).
  54.  
  55.     Exmh_Status "Auto-refiling $msg(id)..."
  56.  
  57.     set target [FolderAutoParse [FolderAutoFind ^List-id:] ]
  58.     if [FolderAutoMove $target] {return}
  59.     set target [FolderAutoParse [FolderAutoFind ^Return-path:] ]
  60.     if [FolderAutoMove $target] {return}
  61.     set target [FolderAutoParse [FolderAutoFind ^From:] ]
  62.     if [FolderAutoMove $target] {return}
  63.     set target [FolderAutoParse [FolderAutoFind ^To:] ]
  64.     if [FolderAutoMove $target] {return}
  65.     set target [FolderAutoParse [FolderAutoFind ^Cc:] ]
  66.     if [FolderAutoMove $target] {return}
  67.  
  68.     Exmh_Status "No target folder found for $msg(id)..."
  69. }
  70.  
  71. proc FolderAutoMove {f} {
  72.     global exmh mhProfile
  73.  
  74.     if [string match $f {}] {return 0}
  75.     set f zoo/$f
  76.     if {[file exists $mhProfile(path)/$f] &&
  77.         [file type $mhProfile(path)/$f] == "link" &&
  78.     [regsub {^../} [file readlink $mhProfile(path)/$f] {} nf]} {
  79.     set f $nf
  80.     }
  81.     if ![file isdirectory $mhProfile(path)/$f] {return 0}
  82.     if [Folder_Target $f] {
  83.     Msg_Move
  84.     }
  85.     return 1
  86. }
  87.  
  88. proc Folder_AutoTrash {m f} {
  89.     global exmh msg
  90.     if [expr [string match $msg(id) $m] && [string match $f $exmh(folder)] ] {
  91.     set savetarget $exmh(target)
  92.     set exmh(target) trash
  93.     Msg_Move
  94.     set exmh(target) $savetarget
  95.     } else {
  96.     Exmh_Status "replied-to $f/$m NOT moved (not current)" warn
  97.     }
  98. }
  99.